structure Main : sig val main : string * string list -> OS.Process.status end =
struct 
  structure TigerLrVals = TigerLrValsFun(structure Token = LrParser.Token)

  structure TigerLex = TigerLexFun(structure Tokens = TigerLrVals.Tokens)

  structure TigerParser = Join(structure ParserData = TigerLrVals.ParserData
                               structure Lex = TigerLex
			       structure LrParser = LrParser)
  structure quad= Quad
  structure reachingdefs = Reachingdefs
  structure genkillgraph = GenKillgraph

  fun parse filename =
      let val _ = ( ErrorMsg.reset()
		  ; ErrorMsg.fileName := filename)
	  val file = TextIO.openIn filename
	  fun get _ = TextIO.input file
	  fun parseError(s,p1,p2) = ErrorMsg.error p1 s
	  val lexer = LrParser.Stream.streamify (TigerLex.makeLexer get)
	  val (absyn, _) = TigerParser.parse(30,lexer,parseError,())
      in ( TextIO.closeIn file
	 ; absyn )
      end handle LrParser.ParseError => raise ErrorMsg.Error;

  fun check absyn = ( FindEscape.findEscape absyn
		    ; let val fs = Semant.transProg absyn
		      in if !ErrorMsg.anyErrors
			 then ( TextIO.output (TextIO.stdErr, "type-checking failed, ")
			      ; raise ErrorMsg.Error )
			 else fs
		      end )
		    
  fun process p fs = let fun pr f = ( TextIO.output (TextIO.stdErr, f)
				    ; TextIO.output (TextIO.stdErr, "\n")
				    ; (p f
				       handle ErrorMsg.Error => TextIO.output (TextIO.stdErr, "continuing to next file\n"))
				    ; OS.Process.success )
		     in let fun loop [] = OS.Process.success
			      | loop [f] = pr f
			      | loop (f::fs) = ( pr f
					       ; loop fs )
			in loop fs
			end
		     end;

  fun main (_, ("-a" ::  fs)) = process (fn f => let val absyn = parse f
						 in ( check absyn
						    ; PrintAbsyn.print (TextIO.stdOut, absyn) )
						 end)
					fs
    | main (_, ("-u" ::  fs)) = process (fn f => let val absyn = parse f
						 in ( check absyn
						    ; UnparseAbsyn.print (TextIO.stdOut, absyn) )
						 end)
					fs
    | main (_, ("-t" :: fs)) = process (fn f => app (fn MipsFrame.STRING (l, s) => TextIO.output (TextIO.stdOut, ("STRING " ^ (Symbol.name l) ^ ":" ^ (String.toString s) ^ "\n"))
						      | MipsFrame.PROC {body,frame=frame as {name,formals,size,moves,saves}} => ( TextIO.output (TextIO.stdOut, ("PROC " ^ (Symbol.name name) ^ ":\n"))
														       ; MipsFrame.showFrame TextIO.stdOut frame
														       ; app (fn stm => ( Printtree.printtree (TextIO.stdOut, stm)
																	; TextIO.output (TextIO.stdOut, "#-----------\n")
															     ))
															     (Canon.traceSchedule (Canon.basicBlocks (Canon.linearize body)))
						    ))
						    (check (parse f)))
				       fs
    | main (_, ("-i" :: fs)) = process (fn f => app (fn MipsFrame.STRING (l, s) => TextIO.output (TextIO.stdOut, ("STRING " ^ (Symbol.name l) ^ ":" ^ (String.toString s) ^ "\n"))
						      | MipsFrame.PROC {body,frame={name,formals,size,moves,saves}} => ( TextIO.output (TextIO.stdOut, ("PROC " ^ (Symbol.name name) ^ ":\n"))
														       ; app (fn stm => ( UnparseTree.printTree (TextIO.stdOut, stm)
																	; TextIO.output (TextIO.stdOut, "#-----------\n")
															     ))
															     (Canon.traceSchedule (Canon.basicBlocks (Canon.linearize body)))
						    ))
						    (check (parse f)))
				       fs
    | main (_, ("-g" :: fs)) = ( MipsFrame.showRegs TextIO.stdOut
			       ; process (fn f => app (fn MipsFrame.STRING (l, s) => TextIO.output (TextIO.stdOut, MipsFrame.string (l, s))
							| MipsFrame.PROC {body,frame as {name,formals,size,moves,saves}} => let val stms = Canon.traceSchedule
																	       (Canon.basicBlocks
																		    (Canon.linearize
																			 (MipsFrame.procEntryExit1 (frame, body))))
															    in let val ass = MipsFrame.procEntryExit2 (frame,
																				       foldr op@ [] (map (MipsGen.codegen frame) stms))
															       in let val {prolog, body, epilog} = MipsFrame.procEntryExit3(frame, ass)
																  in ( TextIO.output (TextIO.stdOut, prolog)
																     ; TextIO.output (TextIO.stdOut,
																		      "#ARGS: "
																		      ^ (UnparseAbsyn.commaSep (map MipsFrame.formalString
																						    formals))
																		      ^ "\n")
																     ; app (fn i => TextIO.output (TextIO.stdOut, i))
																	   (map (Assem.format Temp.makestring) body)
																     ; TextIO.output (TextIO.stdOut, epilog)
																     )
																  end
															       end
															    end)
						      (check (parse f)))
					 fs
			       )
    | main (_, ("-f" :: fs)) = process (fn f => app (fn MipsFrame.STRING (l, s) => TextIO.output (TextIO.stdOut, MipsFrame.string (l, s))
						      | MipsFrame.PROC {body,frame as {name,formals,size,moves,saves}} => let val stms = Canon.traceSchedule
																	     (Canon.basicBlocks
																		  (Canon.linearize
																		       (MipsFrame.procEntryExit1 (frame, body))))
															  in let val ass = MipsFrame.procEntryExit2 (frame,
																				     foldr op@ [] (map (MipsGen.codegen frame) stms))
															     in let val {prolog, body, epilog} = MipsFrame.procEntryExit3(frame, ass)
																in ( TextIO.output (TextIO.stdOut, prolog)
																   ; MakeGraph.show TextIO.stdErr (MakeGraph.instrs2graph body)
																   ; TextIO.output (TextIO.stdOut, epilog)
																   )
																end
															     end
															  end)
						    (check (parse f)))
				       fs
    | main (_, ("-l" :: fs)) = process (fn f => app (fn MipsFrame.STRING (l, s) => TextIO.output (TextIO.stdOut, MipsFrame.string (l, s))
						      | MipsFrame.PROC {body,frame as {name,formals,size,moves,saves}} => let val stms = Canon.traceSchedule
																	     (Canon.basicBlocks
																		  (Canon.linearize
																		       (MipsFrame.procEntryExit1 (frame, body))))
															  in let val ass = MipsFrame.procEntryExit2 (frame,
																				     foldr op@ [] (map (MipsGen.codegen frame) stms))
															     in let val {prolog, body, epilog} = MipsFrame.procEntryExit3(frame, ass)
																in ( TextIO.output (TextIO.stdOut, prolog)
																   ; let val (fg, fns) = MakeGraph.instrs2graph body
																	 val _ = MakeGraph.show TextIO.stdErr (fg, fns)
																	 val (ig, n2ts) = Liveness.interferenceGraph (fg, fns)
																     in ( Liveness.show (TextIO.stdErr, ig)
																	; ListPair.app (fn (n,c) => TextIO.output (TextIO.stdErr,
																						   "#(" ^ Int.toString c
																						   ^ ") == " ^
																						   UnparseAbsyn.commaSep (map Temp.makestring
																									      (n2ts n))
																						   ^ "\n"))
																		       (fns, List.tabulate (length fns, fn x => x))
																	)
																     end
																   ; TextIO.output (TextIO.stdOut, epilog)
																   )
																end
															     end
															  end)
						    (check (parse f)))
				       fs
				       
    | main (_, ("-r" :: fs)) = process (fn f => app (fn MipsFrame.STRING (l, s) => TextIO.output (TextIO.stdOut, MipsFrame.string (l, s))
						      | MipsFrame.PROC {body,frame} => let val stms = Canon.traceSchedule
													  (Canon.basicBlocks
													       (Canon.linearize
														    (MipsFrame.procEntryExit1 (frame, body))))
										       in let val ass = MipsFrame.procEntryExit2 (frame,
																  foldr op@ [] (map (MipsGen.codegen frame) stms))
											  in let val {prolog, body, epilog} = MipsFrame.procEntryExit3(frame, ass)
											     in ( TextIO.output (TextIO.stdOut, prolog)
												; TextIO.output (TextIO.stdErr, "#ALLOCATION TABLE\n")
												; let val (instrs, colors) = RegAlloc.alloc (body, frame)
												  in ( app (fn (t, r) => TextIO.output (TextIO.stdErr,
																	"#"
																	^ (MipsFrame.tempName t)
																	^ " --> "
																	^ r
																	^ "\n"))
													   (Temp.Table.items colors)
												     ; app (fn i => TextIO.output (TextIO.stdOut, i))
													   (map (Assem.format (fn t => Option.getOpt (Temp.Table.look (colors, t),
																		      Temp.makestring t)))
														body)
												     )
												  end
												; TextIO.output (TextIO.stdOut, epilog)
												)
											     end
											  end
										       end)
						    (check (parse f)))
				       fs
    (*our optimization*)
     | main (_, ("-o" :: fs)) = process (fn f => app (fn MipsFrame.STRING (l, s) => TextIO.output (TextIO.stdOut, MipsFrame.string (l, s))
						      | MipsFrame.PROC {body,frame} => let val stms =  quad.quadgenstms(Canon.traceSchedule
													  (Canon.basicBlocks
													       (Canon.linearize
														   (Quad.quadgenstm(MipsFrame.procEntryExit1 (frame, body))))))
									                      val stms2= constantprop.propogateconstants(stms,reachingdefs.reachingdefinitionsGraph(genkillgraph.stms2graph(stms)))
										       in let val ass = MipsFrame.procEntryExit2 (frame,
																  foldr op@ [] (map (MipsGen.codegen frame) stms2))
											  in let val {prolog, body, epilog} = MipsFrame.procEntryExit3(frame, ass)
											     in ( TextIO.output (TextIO.stdOut, prolog)
												; TextIO.output (TextIO.stdErr, "#ALLOCATION TABLE\n")
												; let val (instrs, colors) = RegAlloc.alloc (body, frame)
												  in ( app (fn (t, r) => TextIO.output (TextIO.stdErr,
																	"#"
																	^ (MipsFrame.tempName t)
																	^ " --> "
																	^ r
																	^ "\n"))
													   (Temp.Table.items colors)
												     ; app (fn i => TextIO.output (TextIO.stdOut, i))
													   (map (Assem.format (fn t => Option.getOpt (Temp.Table.look (colors, t),
																		      Temp.makestring t)))
														body)
												     )
												  end
												; TextIO.output (TextIO.stdOut, epilog)
												)
											     end
											  end
										       end)
						    (check (parse f)))
				       fs				   				       
    | main (_, (c ::  fs)) = ( print ("unrecognized command: " ^ c ^ "\n")
			     ; print "usage: -aifglrtu <filenames>\n"
			     ; OS.Process.failure )
    | main (_, _) = ( print "usage: -aifglrtu <filenames>\n"
		    ; OS.Process.failure )
end
